home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue51 / Alfresco / SpeedTests.dpr < prev   
Encoding:
Text File  |  1999-10-03  |  2.9 KB  |  134 lines
  1. program SpeedTests;
  2.  
  3. {$IFDEF Windows}
  4. !! Error - this test program is for Win32 only
  5. {$ENDIF}
  6.  
  7. {$APPTYPE CONSOLE}
  8.  
  9. uses
  10.   Windows,
  11.   SysUtils;
  12.  
  13. const
  14.   ItemCount = 10000;
  15.   Third = 1.0 / 3.0;
  16.  
  17. type
  18.   PSingleArray = ^TSingleArray;
  19.   TSingleArray = array [0..pred(ItemCount)] of single;
  20.   PDoubleArray = ^TDoubleArray;
  21.   TDoubleArray = array [0..pred(ItemCount)] of double;
  22.   PExtendedArray = ^TExtendedArray;
  23.   TExtendedArray = array [0..pred(ItemCount)] of extended;
  24.  
  25.   PPointerArray = ^TPointerArray;
  26.   TPointerArray = array [0..2] of pointer;
  27.  
  28. function GetMisAlignedDoubleArray : PDoubleArray;
  29. var
  30.   P : PPointerArray;
  31. begin
  32.   GetMem(P, sizeof(TDoubleArray) + 8);
  33.   if ((longint(P) mod 8) = 0) then begin
  34.     P^[0] := P;
  35.     Result := pointer(@P^[1]);
  36.   end
  37.   else begin
  38.     P^[1] := P;
  39.     Result := pointer(@P^[2]);
  40.   end;
  41. end;
  42.  
  43. function GetAlignedDoubleArray : PDoubleArray;
  44. var
  45.   PA : PPointerArray;
  46. begin
  47.   GetMem(PA, sizeof(TDoubleArray) + 8);
  48.   if ((longint(PA) mod 8) <> 0) then begin
  49.     PA^[0] := PA;
  50.     Result := pointer(@PA^[1]);
  51.   end
  52.   else begin
  53.     PA^[1] := PA;
  54.     Result := pointer(@PA^[2]);
  55.   end;
  56. end;
  57.  
  58. procedure FreeDoubleArray(DA : PDoubleArray);
  59. var
  60.   P  : PChar;
  61.   PA : PPointerArray;
  62. begin
  63.   P := PChar(DA);
  64.   dec(P, sizeof(pointer));
  65.   PA := pointer(P);
  66.   FreeMem(PA^[0]);
  67. end;
  68.  
  69. var
  70.   StartTime : DWORD;
  71.   EndTime : DWORD;
  72.   SA : PSingleArray;
  73.   DA : PDoubleArray;
  74.   EA : PExtendedArray;
  75.   i  : integer;
  76.   j  : integer;
  77.  
  78. begin
  79.   {perform test on single array}
  80.   writeln('Running tests on singles...');
  81.   New(SA);
  82.   SA^[0] := pi;
  83.   StartTime := GetTickCount;
  84.   for j := 1 to 1000 do
  85.     for i := 1 to pred(ItemCount) do
  86.       SA^[i] := SA^[i-1] + SA^[0] * Third;
  87.   EndTime := GetTickCount;
  88.   Dispose(SA);
  89.   writeln('Single test: ', EndTime - StartTime);
  90.  
  91.  
  92.   {perform test on misaligned double array}
  93.   writeln('Running tests on misaligned doubles...');
  94.   DA := GetMisalignedDoubleArray;
  95.   DA^[0] := pi;
  96.   StartTime := GetTickCount;
  97.   for j := 1 to 1000 do
  98.     for i := 1 to pred(ItemCount) do
  99.       DA^[i] := DA^[i-1] + DA^[0];
  100.   EndTime := GetTickCount;
  101.   FreeDoubleArray(DA);
  102.   writeln('Misaligned Double test: ', EndTime - StartTime);
  103.  
  104.  
  105.   {perform test on aligned double array}
  106.   writeln('Running tests on aligned doubles...');
  107.   DA := GetAlignedDoubleArray;
  108.   DA^[0] := pi;
  109.   StartTime := GetTickCount;
  110.   for j := 1 to 1000 do
  111.     for i := 1 to pred(ItemCount) do
  112.       DA^[i] := DA^[i-1] + DA^[0];
  113.   EndTime := GetTickCount;
  114.   FreeDoubleArray(DA);
  115.   writeln('Aligned Double test: ', EndTime - StartTime);
  116.  
  117.  
  118.   {perform test on extended array}
  119.   writeln('Running tests on extendeds...');
  120.   New(EA);
  121.   EA^[0] := pi;
  122.   StartTime := GetTickCount;
  123.   for j := 1 to 1000 do
  124.     for i := 1 to pred(ItemCount) do
  125.       EA^[i] := EA^[i-1] + EA^[0];
  126.   EndTime := GetTickCount;
  127.   Dispose(EA);
  128.   writeln('Extended test: ', EndTime - StartTime);
  129.  
  130.   readln;
  131. end.
  132.  
  133.  
  134.